home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist01.zoo / lsp / pp.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-11-09  |  15.5 KB  |  499 lines
  1. ; PP.LSP -- a pretty-printer for XLISP.
  2.  
  3. ; Adapted by Jim Chapman (Bix: jchapman) from a program written originally
  4. ; for IQLISP by Don Cohen.  Copyright (c) 1984, Don Cohen; (c) 1987, Jim
  5. ; Chapman.  Permission for non-commercial use and distribution is hereby 
  6. ; granted.  Modified for XLISP 2.0 by David Betz.
  7.  
  8. ; In addition to the pretty-printer itself, this file contains a few functions
  9. ; that illustrate some simple but useful applications.
  10.  
  11. ; The basic function accepts two arguments:
  12.  
  13. ;      (PP OBJECT STREAM)
  14.  
  15. ; where OBJECT is any Lisp expression, and STREAM optionally specifies the
  16. ; output (default is *standard-output*).
  17.  
  18. ; PP-FILE pretty-prints an entire file.  It is what I used to produce this
  19. ; file (before adding the comments manually).  The syntax is:
  20.  
  21. ;       (PP-FILE "filename" STREAM)
  22.  
  23. ; where the file name must be a string or quoted, and STREAM, again, is the
  24. ; optional output destination.
  25.  
  26. ; PP-DEF works just like PP, except its first argument is assumed to be the
  27. ; name of a function or macro, which is translated back into the original
  28. ; DEFUN or DEFMACRO form before printing.
  29.  
  30.  
  31. ; MISCELLANEOUS USAGE AND CUSTOMIZATION NOTES:
  32.  
  33. ; 1.  The program uses tabs whenever possible for indentation.
  34. ;     This greatly reduces the cost of the blank space.  If your output
  35. ;     device doesn't support tabs, set TABSIZE to NIL -- which is what I
  36. ;     did when I pretty-printed this file, because of uncertainty 
  37. ;     about the result after uploading.
  38.  
  39. ; 2.  Printmacros are used to handle special forms.  A printmacro is not
  40. ;     really a macro, just an ordinary lambda form that is stored on the
  41. ;     target symbol's property list.  The default printer handles the form
  42. ;     if there is no printmacro or if the printmacro returns NIL.
  43.  
  44. ; 3.  Note that all the pretty-printer subfunctions, including the
  45. ;     the printmacros, return the current column position.
  46.  
  47. ; 4.  Miser mode is not fully implemented in this version, mainly because  
  48. ;     lookahead was too slow.  The idea is, if the "normal" way of
  49. ;     printing the current expression would exceed the right margin, then
  50. ;     use a mode that conserves horizontal space.
  51.  
  52. ; 5.  When PP gets to the last 8th of the line and has more to print than
  53. ;     fits on the line, it starts near the left margin.  This is not 
  54. ;     wonderful, but neither are the alternatives.  If you have a better
  55. ;     idea, go for it.
  56.  
  57. ;  6. Storage requirements are about 1450 cells to load.  
  58.  
  59. ;  7. I tested this with XLISP 1.7 on an Amiga.
  60.  
  61. ;  8. TAA modified to support prettyprinting arrays.  Fixed bug printing
  62. ;     (NIL ...).
  63.  
  64. ;  9. TAA modified to support prettyprinting of structures, and some code
  65. ;     cleanup. Also added PP-PAIR-FORM to handle setq like structures
  66. ;     more nicely. 
  67.  
  68. ; 10. TAA: It should be noted that you can't pretty print circular lists,
  69. ;     nor can you successfully read back the following:
  70. ;    * uninterned symbols, for instance those generated with gensym
  71. ;         as part of automatically generated code
  72. ;       * closures, since their environment cannot be reconstructed. These
  73. ;         are not even expanded.
  74. ;       * subrs, fsubrs, and streams cannot be represented
  75.  
  76. ; 11. TAA modified so that non-class objects are shown by sending the
  77. ;    message :storeon (see classes.lsp)
  78.  
  79. ; 11. TAA modified so that *print-level* and *print-length* are bound to  NIL
  80. ;    during the course of execution.
  81.  
  82. ; An ugly false def so things don't fall apart if classes.lsp not loaded
  83. (unless (fboundp 'defclass) (defun classp (x) (objectp x)))
  84.  
  85.  
  86.  
  87.  
  88. ;(DEFUN SYM-FUNCTION (X)    ;for Xlisp 1.7
  89. ;    (CAR (SYMBOL-VALUE X)))
  90. (DEFUN SYM-FUNCTION (X)        ;for Xlisp 2.0
  91.     (GET-LAMBDA-EXPRESSION (SYMBOL-FUNCTION X)))
  92.  
  93. (DEFVAR TABSIZE 8)    ;set this to NIL for no tabs
  94.  
  95. (DEFVAR MAXSIZE 50)    ;for readability, PP tries not to print more
  96.             ;than this many characters on a line
  97.  
  98. (DEFVAR MISER-SIZE 2)    ;the indentation in miser mode
  99.  
  100. (DEFVAR MIN-MISER-CAR 4)    ;used for deciding when to use miser mode
  101.  
  102. (DEFVAR MAX-NORMAL-CAR 9)    ;ditto
  103.  
  104. (DEFCONSTANT PP-LPAR "(")    ; self evident
  105. (DEFCONSTANT PP-RPAR ")")
  106. (DEFCONSTANT PP-SPACE " ")
  107.  
  108. ; The following function prints a file
  109.  
  110. (DEFUN PP-FILE (FILENAME &OPTIONAL STREAMOUT)
  111.     (OR STREAMOUT (SETQ STREAMOUT *STANDARD-OUTPUT*))
  112.     (PRINC "; Listing of " STREAMOUT)
  113.     (PRINC FILENAME STREAMOUT)
  114.     (TERPRI STREAMOUT)
  115.     (TERPRI STREAMOUT)
  116.     (DO* ((FP (OPEN FILENAME)) (EXPR (READ FP) (READ FP)))
  117.          ((NULL EXPR) (CLOSE FP))
  118.       (PP EXPR STREAMOUT)
  119.       (TERPRI STREAMOUT)))
  120.  
  121.  
  122. ; Print a lambda or macro form as a DEFUN or DEFMACRO:
  123.  
  124. (DEFMACRO PP-DEF (WHO &OPTIONAL STREAM)
  125.     `(PP (MAKE-DEF ,WHO) ,STREAM))
  126.  
  127. (DEFMACRO MAKE-DEF (NAME &AUX EXPR TYPE)
  128.     (SETQ EXPR (SYM-FUNCTION NAME))
  129.     (SETQ TYPE
  130.           (CADR (ASSOC (CAR EXPR)
  131.                        '((LAMBDA DEFUN) (MACRO DEFMACRO)))))
  132.     (LIST 'QUOTE
  133.           (APPEND (LIST TYPE NAME) (CDR EXPR))))
  134.  
  135.  
  136.  
  137. ; The pretty-printer high level function:
  138.  
  139.  
  140. (DEFUN PP (X &OPTIONAL STREAM)
  141.        (PROGV '(*PRINT-LEVEL* *PRINT-LENGTH*) '(NIL NIL)
  142.           (OR STREAM (SETQ STREAM *STANDARD-OUTPUT*))
  143.           (PP1 X STREAM 1 80)
  144.           (TERPRI STREAM)
  145.           T))
  146.  
  147. ; print X on STREAM, current cursor is CURPOS, and right margin is RMARGIN
  148.  
  149. (DEFUN PP1 (X STREAM CURPOS RMARGIN 
  150.           &AUX (ANARRAY (ARRAYP X))
  151.            (ASTRUCT (NOT (MEMBER (TYPE-OF X) 
  152.                      '(SYMBOL
  153.                        NIL
  154.                        OBJECT
  155.                        CONS 
  156.                        SUBR 
  157.                        FSUBR 
  158.                        CLOSURE 
  159.                        STRING
  160.                        FIXNUM
  161.                        FLONUM
  162.                        CHARACTER
  163.                        FILE-STREAM
  164.                        UNNAMED-STREAM
  165.                        ARRAY))))
  166.            SIZE POSITION WIDTH)
  167.     (WHEN ANARRAY (SETQ X (COERCE X 'CONS)))
  168.     (WHEN (AND (OBJECTP X) (NOT (CLASSP X)))
  169.       (SETQ X (SEND X :STOREON)))
  170.     (COND (ASTRUCT (PP-ASTRUCT X STREAM CURPOS RMARGIN))
  171.       ((NOT (CONSP X))(PRIN1 X STREAM) (+ CURPOS (FLATSIZE X)))
  172.           ((PRINTMACROP X STREAM CURPOS RMARGIN))
  173.           ((AND (> (FLATSIZE X) (- RMARGIN CURPOS))
  174.                 (< (* 8 (- RMARGIN CURPOS)) RMARGIN))
  175.            (SETQ SIZE (+ (/ RMARGIN 8) (- CURPOS RMARGIN)))
  176.            (PP-MOVETO STREAM CURPOS SIZE)
  177.            (SETQ POSITION (PP1 X STREAM SIZE RMARGIN))
  178.            (PP-MOVETO STREAM POSITION SIZE))
  179.           (T (WHEN ANARRAY (PRINC "#" STREAM) (SETQ CURPOS (1+ CURPOS)))
  180.          (PRINC PP-LPAR STREAM)
  181.              (SETQ POSITION
  182.                    (PP1 (CAR X) STREAM (1+ CURPOS) RMARGIN))
  183.              (COND ((AND (>= (SETQ WIDTH (- RMARGIN POSITION))
  184.                              (SETQ SIZE (FLATSIZE (CDR X))))
  185.                          (<= SIZE MAXSIZE))
  186.                     (PP-REST-ACROSS (CDR X) STREAM POSITION RMARGIN))
  187.                    ((CONSP (CAR X))
  188.                     (PP-MOVETO STREAM POSITION CURPOS)
  189.                     (PP-REST (CDR X) STREAM CURPOS RMARGIN))
  190.                    ((> (- POSITION CURPOS) MAX-NORMAL-CAR)
  191.                     (PP-MOVETO STREAM POSITION (+ CURPOS MISER-SIZE))
  192.                     (PP-REST (CDR X) STREAM (+ CURPOS MISER-SIZE) RMARGIN))
  193.                    (T (PP-REST (CDR X) STREAM POSITION RMARGIN))))))
  194.  
  195. ; PP-MOVETO controls indentating and tabbing.
  196. ; If CUR > GOAL then goes to new line first.
  197. ; will space to GOAL
  198.  
  199. (DEFUN PP-MOVETO (STREAM CURPOS GOALPOS &AUX I)
  200.     (COND ((> CURPOS GOALPOS)
  201.            (TERPRI STREAM)
  202.            (SETQ CURPOS 1)
  203.            (IF TABSIZE
  204.                (DO NIL
  205.                    ((< (- GOALPOS CURPOS) TABSIZE))
  206.                  (PRINC "\t" STREAM)
  207.                  (SETQ CURPOS (+ CURPOS TABSIZE))))))
  208.     (DOTIMES (I (- GOALPOS CURPOS)) (PRINC PP-SPACE STREAM))
  209.     GOALPOS)
  210.  
  211. ; Can print the rest of the list without new lines
  212.  
  213. (DEFUN PP-REST-ACROSS (X STREAM CURPOS RMARGIN &AUX POSITION)
  214.     (SETQ POSITION CURPOS)
  215.     (PROG NIL
  216.       LP
  217.       (COND ((NULL X) (PRINC PP-RPAR STREAM) (RETURN (1+ POSITION)))
  218.             ((NOT (CONSP X))
  219.              (PRINC " . " STREAM)
  220.              (PRIN1 X STREAM)
  221.              (PRINC PP-RPAR STREAM)
  222.              (RETURN (+ 4 POSITION (FLATSIZE X))))
  223.             (T (PRINC PP-SPACE STREAM)
  224.                (SETQ POSITION
  225.                      (PP1 (CAR X) STREAM (1+ POSITION) RMARGIN))
  226.                (SETQ X (CDR X))
  227.                (GO LP)))))
  228.  
  229. ; Can print the rest of the list, but must use new lines for each element
  230.  
  231.  
  232. (DEFUN PP-REST (X STREAM CURPOS RMARGIN &AUX POSITION POS2)
  233.     (SETQ POSITION CURPOS)
  234.     (PROG NIL
  235.       LP
  236.       (COND ((NULL X) (PRINC PP-RPAR STREAM) (RETURN (1+ POSITION)))
  237.             ((NOT (CONSP X))
  238.              (AND (> (FLATSIZE X) (- (- RMARGIN POSITION) 3))
  239.                   (SETQ POSITION (PP-MOVETO STREAM POSITION CURPOS)))
  240.              (PRINC " . " STREAM)
  241.              (PRIN1 X STREAM)
  242.              (PRINC PP-RPAR STREAM)
  243.              (RETURN (+ POSITION 4 (FLATSIZE X))))
  244.             ((AND (MEMBER (TYPE-OF (CAR X)) 
  245.               '(SYMBOL SUBR FSUBR CLOSURE STRING 
  246.                    FIXNUM FLONUM CHARACTER 
  247.                    FILE-STREAM  UNNAMED-STREAM))
  248.                   (<= (SETQ POS2 (+ 1 POSITION (FLATSIZE (CAR X))))
  249.                       RMARGIN)
  250.                   (<= POS2 (+ CURPOS MAXSIZE)))
  251.              (PRINC PP-SPACE STREAM)
  252.              (PRIN1 (CAR X) STREAM)
  253.              (SETQ POSITION POS2))
  254.             (T (PP-MOVETO STREAM POSITION (1+ CURPOS))
  255.                (SETQ POSITION
  256.                      (PP1 (CAR X) STREAM (1+ CURPOS) RMARGIN))))
  257.       (COND ((AND (CONSP (CAR X)) (CDR X))
  258.              (SETQ POSITION (PP-MOVETO STREAM POSITION CURPOS))))
  259.       (SETQ X (CDR X))
  260.       (GO LP)))
  261.  
  262.  
  263. ; Handles structures by printing in form:
  264. ;    #S(structtype :slot val
  265. ; ...
  266. ;              :slot val)
  267. ;
  268. ; code does not check for defaults.
  269.  
  270. (DEFUN PP-ASTRUCT (X STREAM POS RMAR &AUX CUR SNAMES ARGS)
  271.        (SETQ CUR POS
  272.          SNAMES (MAPCAR #'CAR (GET (TYPE-OF X) '*STRUCT-SLOTS*))
  273.          ARGS 
  274.          (MAPCAN #'(LAMBDA (P) 
  275.                    (LIST (MAKE-SYMBOL (CONCATENATE  'STRING
  276.                                 ":"
  277.                                 (STRING P)))
  278.                      (APPLY
  279.                       (INTERN
  280.                        (CONCATENATE 'STRING 
  281.                             (STRING (TYPE-OF X)) 
  282.                             "-" 
  283.                             (STRING P)))
  284.                       (LIST X))))
  285.              SNAMES))
  286.        (PRINC "#S" STREAM)
  287.        (IF (AND (>= (- RMAR POS) (+ 2 (FLATSIZE X)))
  288.         (<= (FLATSIZE X) MAXSIZE))
  289.        (PP1 (CONS (TYPE-OF X) ARGS) STREAM (+ 2 POS) RMAR)
  290.        (PROG ()
  291.          (PRINC PP-LPAR STREAM)
  292.          (PRIN1 (TYPE-OF X) STREAM)
  293.          (PRINC PP-SPACE STREAM)
  294.          (SETQ POS (SETQ CUR (+ POS 4 (FLATSIZE (TYPE-OF X)))))
  295.          LP
  296.          (PRIN1 (FIRST ARGS) STREAM)
  297.          (PRINC PP-SPACE STREAM)
  298.          (SETQ CUR
  299.                (PP1 (SECOND ARGS)
  300.                 STREAM
  301.                 (+ POS 1 (FLATSIZE (FIRST ARGS)))
  302.                 RMAR))
  303.          (SETQ ARGS (CDDR ARGS))
  304.          (WHEN (NULL ARGS)
  305.                (PRINC PP-RPAR STREAM)
  306.                (RETURN-FROM PP-ASTRUCT (1+ CUR)))
  307.          (PP-MOVETO STREAM CUR POS)
  308.          (GO LP))))
  309.  
  310.          
  311. ; PRINTMACROP is the printmacro interface routine.  Note that the
  312. ; called function has the same argument list as PP1.  It may either
  313. ; decide not to handle the form, by returning NIL (and not printing)
  314. ; or it may print the form and return the resulting position.
  315.  
  316. (DEFUN PRINTMACROP (X STREAM CURPOS RMARGIN &AUX MACRO)
  317.     (AND (SYMBOLP (CAR X))
  318.      (CAR X)    ; must not be NIL (TAA fix)
  319.          (SETQ MACRO (GET (CAR X) 'PRINTMACRO))
  320.          (APPLY MACRO (LIST X STREAM CURPOS RMARGIN))))
  321.  
  322. ; The remaining forms define various printmacros.
  323.  
  324.  
  325. ; Printing format (xxx xxx
  326. ;               <pp-rest>)
  327.  
  328.  
  329. (DEFUN PP-BINDING-FORM (X STREAM POS RMAR &AUX CUR)
  330.     (SETQ CUR POS)
  331.     (COND ((AND (>= (- RMAR POS) (FLATSIZE X))
  332.                 (<= (FLATSIZE X) MAXSIZE)) NIL)
  333.           ((> (LENGTH X) 2)
  334.            (PRINC PP-LPAR STREAM)
  335.            (PRIN1 (CAR X) STREAM)
  336.            (PRINC PP-SPACE STREAM)
  337.            (SETQ CUR
  338.                  (PP1 (CADR X)
  339.                       STREAM
  340.                       (+ 2 POS (FLATSIZE (CAR X)))
  341.                       RMAR))
  342.            (PP-MOVETO STREAM CUR (+ POS 1))
  343.            (PP-REST (CDDR X) STREAM (+ POS 1) RMAR))))
  344.  
  345. ; Format (xxxx xxx xxx
  346. ;...
  347. ;           xxx xxx)
  348.  
  349. (DEFUN PP-PAIR-FORM (X STREAM POS RMAR &AUX CUR)
  350.     (SETQ CUR POS)
  351.     (COND ((AND (>= (- RMAR POS) (FLATSIZE X))
  352.                 (<= (FLATSIZE X) MAXSIZE)) NIL)
  353.           ((> (LENGTH X) 1)
  354.            (PRINC PP-LPAR STREAM)
  355.            (PRIN1 (FIRST X) STREAM)
  356.            (PRINC PP-SPACE STREAM)
  357.        (SETQ POS (SETQ CUR (+ POS 2 (FLATSIZE (FIRST X)))))
  358.        (SETQ X (REST X))
  359.        (LOOP
  360.         (PP-MOVETO STREAM CUR POS)
  361.         (SETQ CUR (PP1 (FIRST X) STREAM POS RMAR))
  362.         (PRINC PP-SPACE STREAM)
  363.         (SETQ X (REST X))
  364.         (SETQ CUR (PP1 (FIRST X) STREAM (1+ CUR) RMAR))
  365.         (WHEN (NULL (SETQ X (REST X)))
  366.           (PRINC PP-RPAR STREAM)
  367.           (RETURN-FROM PP-PAIR-FORM (1+ CUR)))))))
  368.  
  369. ; format (xxx xxx
  370. ;          xxx
  371. ;        <pprest>)
  372.  
  373.        
  374. (DEFUN PP-DO-FORM (X STREAM POS RMAR &AUX CUR POS2)
  375.     (SETQ CUR POS)
  376.     (COND ((AND (>= (- RMAR POS) (FLATSIZE X))
  377.                 (<= (FLATSIZE X) MAXSIZE)) NIL)
  378.           ((> (LENGTH X) 2)
  379.            (PRINC PP-LPAR STREAM)
  380.            (PRIN1 (CAR X) STREAM)
  381.            (PRINC PP-SPACE STREAM)
  382.            (SETQ POS2 (+ 2 POS (FLATSIZE (CAR X))))
  383.            (SETQ CUR (PP1 (CADR X) STREAM POS2 RMAR))
  384.            (PP-MOVETO STREAM CUR POS2)
  385.            (SETQ CUR (PP1 (CADDR X) STREAM POS2 RMAR))
  386.            (PP-MOVETO STREAM CUR (+ POS 1))
  387.            (PP-REST (CDDDR X) STREAM (+ POS 1) RMAR))))
  388.  
  389. ; format (xxx xxx xxx
  390. ;       <pprest>)
  391.  
  392. (DEFUN PP-DEFINING-FORM (X STREAM POS RMAR &AUX CUR)
  393.     (SETQ CUR POS)
  394.     (COND ((AND (>= (- RMAR POS) (FLATSIZE X))
  395.                 (<= (FLATSIZE X) MAXSIZE)) NIL)
  396.           ((> (LENGTH X) 3)
  397.            (PRINC PP-LPAR STREAM)
  398.            (PRIN1 (CAR X) STREAM)
  399.            (PRINC PP-SPACE STREAM)
  400.            (PRIN1 (CADR X) STREAM)
  401.            (PRINC PP-SPACE STREAM)
  402.            (SETQ CUR
  403.                  (PP1 (CADDR X)
  404.                       STREAM
  405.                       (+ 3 POS (FLATSIZE (CAR X)) (FLATSIZE (CADR X)))
  406.                       RMAR))
  407.            (PP-MOVETO STREAM CUR (+ 3 POS))
  408.            (PP-REST (CDDDR X) STREAM (+ 3 POS) RMAR))))
  409.  
  410. (PUTPROP 'QUOTE
  411.          '(LAMBDA (X STREAM POS RMARGIN)
  412.             (COND ((AND (CDR X) (NULL (CDDR X)))
  413.                    (PRINC "'" STREAM)
  414.                    (PP1 (CADR X) STREAM (1+ POS) RMARGIN))))
  415.          'PRINTMACRO)
  416.  
  417. (PUTPROP 'BACKQUOTE
  418.          '(LAMBDA (X STREAM POS RMARGIN)
  419.             (COND ((AND (CDR X) (NULL (CDDR X)))
  420.                    (PRINC "`" STREAM)
  421.                    (PP1 (CADR X) STREAM (1+ POS) RMARGIN))))
  422.          'PRINTMACRO)
  423.  
  424. (PUTPROP 'COMMA
  425.          '(LAMBDA (X STREAM POS RMARGIN)
  426.             (COND ((AND (CDR X) (NULL (CDDR X)))
  427.                    (PRINC "," STREAM)
  428.                    (PP1 (CADR X) STREAM (1+ POS) RMARGIN))))
  429.          'PRINTMACRO)
  430.  
  431. (PUTPROP 'COMMA-AT
  432.          '(LAMBDA (X STREAM POS RMARGIN)
  433.             (COND ((AND (CDR X) (NULL (CDDR X)))
  434.                    (PRINC ",@" STREAM)
  435.                    (PP1 (CADR X) STREAM (+ POS 2) RMARGIN))))
  436.          'PRINTMACRO)
  437.  
  438. (PUTPROP 'FUNCTION
  439.          '(LAMBDA (X STREAM POS RMARGIN)
  440.             (COND ((AND (CDR X) (NULL (CDDR X)))
  441.                    (PRINC "#'" STREAM)
  442.                    (PP1 (CADR X) STREAM (+ POS 2) RMARGIN))))
  443.          'PRINTMACRO)
  444.  
  445. (PUTPROP 'PROG
  446.          'PP-BINDING-FORM
  447.          'PRINTMACRO)
  448.  
  449. (PUTPROP 'PROG*
  450.          'PP-BINDING-FORM
  451.          'PRINTMACRO)
  452.  
  453. (PUTPROP 'LET
  454.          'PP-BINDING-FORM
  455.          'PRINTMACRO)
  456.  
  457. (PUTPROP 'LET*
  458.          'PP-BINDING-FORM
  459.          'PRINTMACRO)
  460.  
  461. (PUTPROP 'LAMBDA
  462.          'PP-BINDING-FORM
  463.          'PRINTMACRO)
  464.  
  465. (PUTPROP 'MACRO
  466.          'PP-BINDING-FORM
  467.          'PRINTMACRO)
  468.  
  469. (PUTPROP 'DO 'PP-DO-FORM 'PRINTMACRO)
  470.  
  471. (PUTPROP 'DO*
  472.          'PP-DO-FORM
  473.          'PRINTMACRO)
  474.  
  475. (PUTPROP 'DEFUN
  476.          'PP-DEFINING-FORM
  477.          'PRINTMACRO)
  478.  
  479. (PUTPROP 'DEFMACRO
  480.          'PP-DEFINING-FORM
  481.          'PRINTMACRO)
  482.  
  483.  
  484. (PUTPROP 'SETQ
  485.      'PP-PAIR-FORM
  486.      'PRINTMACRO)
  487.  
  488. (PUTPROP 'SETF
  489.      'PP-PAIR-FORM
  490.      'PRINTMACRO)
  491.  
  492. (PUTPROP 'SETV
  493.      'PP-PAIR-FORM
  494.      'PRINTMACRO)
  495.  
  496.  
  497. (PUTPROP 'SEND
  498.      'PP-DEFINING-FORM
  499.      'PRINTMACRO)